home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
advcrt90.zip
/
ADVCRT.DOC
< prev
next >
Wrap
Text File
|
1993-01-04
|
42KB
|
527 lines
(*****************************************************************************
* *
* ADVCRT - Advanced Screen and Keyboard Manipulation Routines *
* for Borland International's Turbo Pascal Version 5.5 *
* *
* Serial Number: 000000 - Released June 19, 1990 *
* Licensed to: Author *
* For: Normal use *
* Current Version: 9.0 *
* *
*****************************************************************************
* *
* Description of AdvCRT Routines: *
* *
*****************************************************************************
* *
* Procedure FindScreenBase(var ScreenBase: Word); *
* { *
* DESCRIPTION: *
* Returns type of display adaptor installed in the form of the *
* Video Segment Address. *
* PARAMETERS: *
* ScreenBase (out) - Video Segment Address of display *
* Hex B800 - SVGA/VGA/EGA/CGA/MCGA card *
* Hex B000 - Monochrome card *
* NOTE(S): *
* Used primarily for DirectOut procedure. *
* ----------------------------------------------------------------------} *
* *
* Function QuickScreenBase: Word; *
* { *
* DESCRIPTION: *
* Returns the Video Segment Address of the current video *
* display adaptor installed. Used instead of a global variable *
* and the FindScreenBase procedure. *
* ----------------------------------------------------------------------} *
* *
* Function MakeAttr(Fore, Back: Byte): Byte; *
* { *
* DESCRIPTION: *
* Converts given Foreground and Background colors into a *
* single Attribute byte for low level machine calls. *
* PARAMETERS: *
* Fore (in) - Foreground of Attribute to make *
* Back (in) - Background of Attribute to make *
* NOTE(S): *
* Opposite of ExtractAttr procedure. *
* ----------------------------------------------------------------------} *
* *
* Procedure ExtractAttr(Attr: Byte; var Fore, Back: Byte); *
* { *
* DESCRIPTION: *
* Converts machine Attribute (single number) to Compiler *
* specific Foreground and Background colors. *
* PARAMETERS: *
* Attr (in) - Attribute byte used in low level machine calls *
* Fore (out) - Foreground color extracted from Attr *
* Back (out) - Background color extracted from Attr *
* NOTE(S): *
* Opposite of MakeAttr function. *
* ----------------------------------------------------------------------} *
* *
* Procedure TurnCursor(ONorOFF: Boolean); *
* { *
* DESCRIPTION: *
* Turns the cursor ON or OFF. That is, makes it visible or *
* invisble. Current cursor shape is retained in the global *
* variable SaveCursor. *
* PARAMETERS: *
* ONorOFF (in) - Pass in ON to make cursor visible, OFF to hide *
* cursor *
* SYNTAX: *
* 1. TurnCursor(OFF); - Hide Cursor *
* 2. TurnCursor(ON); - Reveal Cursor *
* ----------------------------------------------------------------------} *
* *
* Procedure SetCursor(StartScan, EndScan: Byte); *
* { *
* DESCRIPTION: *
* Sets cursor to a specific size. *
* PARAMETERS: *
* StartScan (in) - Start cursor scan line (upper half) (0-13) *
* EndScan (in) - Ending cursor scan line (bottom half) (0-13) *
* NOTE(S): *
* If StartScan>EndScan the cursor will become invisible. *
* ----------------------------------------------------------------------} *
* *
* Procedure Scroll(X1,Y1,X2,Y2, LinesToScroll, BlankLineAttr, *
* UPorDOWN: Byte); *
* { *
* DESCRIPTION: *
* Scrolls a particular area of the screen up or down. *
* PARAMETERS: *
* X1, Y1 (in) - Coord. of upper-left area to be scrolled *
* X2, Y2 (in) - Coord. of lower-right area to be scrolled *
* LinesToScroll (in) - Number of lines to scroll *
* BlankLineAttr (in) - Attribute to fill the blank area with *
* UpOrDown (in) - Direction to scroll the area - 0=Up, 1=Down *
* NOTE(S): *
* (X1,Y1), (X2,Y2) are related to the coordinates given for *
* Turbo Pascal's standard Window procedure. *
* ----------------------------------------------------------------------} *
* *
* Procedure TurnScreen(ONorOFF: Boolean); *
* { *
* DESCRIPTION: *
* Turns the display ON or OFF software wise. If OFF, all output *
* to the screen is written, but not shown. Clearing the screen *
* along with a TurnScreen(ON) will reactivate the display. *
* SYNTAX: *
* 1. TurnScreen(OFF); - Turn Screen OFF--Software Wise *
* 2. TurnScreen(ON); - Turn Screen ON *
* NOTE(S): *
* Note that a DIRECT screen write while the screen is OFF will *
* infact show up on the display. If you wish to write to the *
* screen while it is "OFF", use Turbo's WRITE and WRITELN. *
* ----------------------------------------------------------------------} *
* *
* Procedure DirectOut(X,Y: Byte; aStr: String; Attr: Byte); *
* { *
* DESCRIPTION: *
* Writes a string of information directly to video display memory. *
* This routine is not the fastest possible, since it actually *
* outputs a character at a time. *
* PARAMETERS: *
* X, Y (in) - Coordinates where string should be displayed *
* aStr (in) - String to be displayed on screen *
* Attr (in) - Attribute to be used when displaying *
* NOTE(S): *
* See MakeAttr function for information on procedure that need *
* machine level attributes. *
* ----------------------------------------------------------------------} *
* *
* Procedure SetBorder(BordColor: Byte); *
* { *
* DESCRIPTION: *
* Sets screen border color. Works on all classes of PC's *
* including PCjr. *
* PARAMETERS: *
* BorderColor (in) - Color to set the screen's border to *
* NOTE(S): *
* Can also be achieved on a PC with a simple Port call. This *
* routine works on all PC's including PCjr. *
* ----------------------------------------------------------------------} *
* *
* Procedure GetCursorPos(var X,Y: Byte; Page: Byte); *
* { *
* DESCRIPTION: *
* Returns the position of the cursor on the screen on a given *
* Video Display Page. *
* PARAMETERS: *
* X, Y (out) - Returns the coordinates of the cursor *
* Page (in) - The display page to scan for the cursor position *
* NOTE(S): *
* Quite similar to WhereX and WhereY, but can be used on any *
* given display page. Makes AdvCRT Unit dependant only on *
* the DOS Unit. *
* ----------------------------------------------------------------------} *
* *
* Procedure GetCRTMode(var Mode, Columns, ActivePage: Byte); *
* { *
* DESCRIPTION: *
* Returns the current mode of the video display adaptor. *
* PARAMETERS: *
* Mode (out) - Current mode of the CRT *
* 0 - 40 column B&W text mode *
* 1 - 40 column color text mode *
* 2 - 80 column B&W text mode *
* 3 - 80 column 16 color text mode *
* 4 - 4 color med-resolution graphics mode *
* 5 - 4 grey color med-resolution graphics mode *
* 6 - 2 color B&W high-resolution graphics mode *
* 7 - 80 column monochrome mode *
* 8 - 15 graphics modes for EGA Card *
* Columns (out) - Current number of columns on the screen *
* ActivePage (out) - Active display page number *
* ----------------------------------------------------------------------} *
* *
* Function ActiveDisplayPage: Byte; *
* { *
* DESCRIPTION: *
* Returns the active Video Display Page. Useful for other *
* routines that demand a Page be passed into them. *
* SYNTAX: *
* 1. Writeln(ActiveDisplayPage); *
* 2. GetCharXY(12,3, ActiveDisplayPage, Ch, Attr); *
* ----------------------------------------------------------------------} *
* *
* Procedure SetPage(Page: Byte); *
* { *
* DESCRIPTION: *
* Sets active display page. *
* PARAMETERS: *
* Page (in) - Display page to switch to *
* NOTE(S): *
* Page is [0-3] in 80 column text mode *
* [4-7] in graphics modes. *
* Can be used in conjunction with ClrPage, WriteStrPage, *
* and WriteChPage procedures to produce "instant" pages of text. *
* ----------------------------------------------------------------------} *
* *
* Procedure SetCurPosPage(X,Y, Page: Byte); *
* { *
* DESCRIPTION: *
* Sets the cursor position on a give page. Used primarily by *
* other procedures within this Unit, but can be called *
* separately. *
* PARAMETERS: *
* X, Y (in) - Coordinates on which the cursor should be placed *
* Page (in) - Display page to use *
* NOTE(S): *
* Remember that the display page on which you may be positioning *
* the cursor may not be the ACTIVE display page. *
* ----------------------------------------------------------------------} *
* *
* Procedure GetCharXY(X,Y, Page: Byte; var Ch: Char; var Attr: Byte); *
* { *
* DESCRIPTION: *
* Scans the CRT for the character and its attribute at a given *
* position on a given display page. *
* PARAMETERS: *
* X, Y (in) - Coordinates of position to be scanned *
* Page (in) - Display page to scan *
* Ch (out) - Character found at requested position *
* Attr (out) - Attribute of the character found *
* NOTE(S): *
* Since a character does exist at every position on the screen *
* on any page, Ch will return a "blank" character (#32) if no *
* other character was found. *
* ----------------------------------------------------------------------} *
* *
* Procedure WriteChPage(X,Y, Page: Byte; Ch: Char; NumReps: Integer; *
* Attr: Byte); *
* { *
* DESCRIPTION: *
* Writes a character at screen coordinates X, Y (Column, Row *
* respectively) on a given Display Page with a given *
* Attribute. *
* PARAMETERS: *
* X, Y (in) - Coordinates at which to write the character *
* Page (in) - Display page to write to *
* Ch (in) - Actual character to write *
* NumReps (in) - Number of times to write the character *
* Attr (in) - Attribute to use when writing the character *
* SYNTAX: *
* 1. WriteChPage(12,3, ActiveDisplayPage, 'G', 1, MakeAttr(15,1)); *
* 2. WriteChPage(13,4, 0, 'a', 2, 7); *
* NOTE(S): *
* Use with other page routines to create instant pages of text. *
* ----------------------------------------------------------------------} *
* *
* Procedure WriteStrPage(X,Y, Page: Byte; aStr: String; Attr: Byte); *
* { *
* DESCRIPTION: *
* Writes a string at screen coordinates X, Y on a given Display *
* Page with a give Attribute. *
* PARAMETERS: *
* X, Y (in) - Coordinates at which to write the string *
* Page (in) - Display page to write to *
* aStr (in) - Actual string to write *
* Attr (in) - Attribute to use when writing the string *
* SYNTAX: *
* 1. WriteStrPage(1,10, ActiveDisplayPage, 'Turbo', 7); *
* 2. WriteStrPage(2,23, 1, 'Hello', MakeAttr(0,3)); *
* NOTE(S): *
* Use with other page routines to create instant pages of text. *
* ----------------------------------------------------------------------} *
* *
* Procedure ClrPage(Page: Byte); *
* { *
* DESCRIPTION: *
* Clears a given Display Page and sets the cursor to the upper *
* left hand corner of that page. Similar to ClrScr procedure. *
* PARAMETERS: *
* Page (in) - Display page to clear *
* NOTE(S): *
* Should be called before writing to a given display page, since *
* that page may have "garbage" from previous applications. *
* ----------------------------------------------------------------------} *
* *
* Procedure GetKey(var Code: Byte; var Extkey: Boolean); *
* { *
* DESCRIPTION: *
* Gets a key from the keyboard--returns it's ASCII value and *
* whether or not it is "extended". *
* PARAMETERS: *
* Code (out) - ASCII value of key pressed (See Turbo Manual) *
* Extkey (out) - TRUE if key is "extended", FALSE otherwise *
* SYNTAX: *
* GetKey(Code, Extended); *
* NOTE(S): *
* Normal keys return a single code with Extkey set to FALSE, *
* extended keys (Alt-A, F10, Alt-F3, etc) return a single *
* code (See Turbo Manual) with Extkey set to TRUE. *
* ----------------------------------------------------------------------} *
* *
* Function CapsLockON: Boolean; *
* { *
* DESCRIPTION: *
* Returns TRUE if Caps-Lock key is active--FALSE otherwise. *
* SYNTAX: *
* If CapsLockON Then *
* WriteLn('Caps-Lock key is currently ENABLED'); *
* ----------------------------------------------------------------------} *
* *
* Function NumLockON: Boolean; *
* { *
* DESCRIPTION: *
* Returns TRUE if Num-Lock key is active--FALSE otherwise. *
* ----------------------------------------------------------------------} *
* *
* Function ScrollLockON: Boolean; *
* { *
* DESCRIPTION: *
* Returns TRUE if Scroll-Lock key is active--FALSE otherwise. *
* ----------------------------------------------------------------------} *
* *
* Function RightShift: Boolean; *
* { *
* DESCRIPTION: *
* Returns TRUE if the Right Shift key is depressed at the time of *
* the call to the function--FALSE otherwise. *
* ----------------------------------------------------------------------} *
* *
* Function LeftShift: Boolean; *
* { *
* DESCRIPTION: *
* Returns TRUE if the Left Shift key is depressed at the time of *
* the call to the function--FALSE otherwise. *
* ----------------------------------------------------------------------} *
* *
* Function AltPressed: Boolean; *
* { *
* DESCRIPTION: *
* Returns TRUE if the Alt key is depressed at the time of the *
* call to the function--FALSE otherwise. *
* ----------------------------------------------------------------------} *
* *
* Function CtrlPressed: Boolean; *
* { *
* DESCRIPTION: *
* Returns TRUE if the Ctrl key is depressed at the time of the *
* call to the function--FALSE otherwise. *
* ----------------------------------------------------------------------} *
* *
* Function InsertModeON: Boolean; *
* { *
* DESCRIPTION: *
* Returns TRUE if the machine global insert mode is active at *
* the time of the call to the function--FALSE otherwise. * *
* ----------------------------------------------------------------------} *
* *
* Procedure SaveScreen(var aScreen: ScreenType; Height: Byte; *
* var Status: Byte); *
* { *
* DESCRIPTION: *
* Saves the contents of the TEXT screen to memory. Each screen *
* needs about 4000 bytes (4k) of memory. You may have as many *
* screens saved to memory as you wish, however one page *
* (VirtualPage, of type ScreenType) is supplied for you at the *
* VARiable declaration of this UNIT. *
* PARAMETERS: *
* aScreen (out) - Screen is saved to this varialbe: All Chars, *
* their attributes, and the Height of the Screen. *
* Height (in) - The height of your screen--usually 25, may differ *
* according to Display Adaptor (VGA/EGA/etc). *
* Status (out) - Returns 0 if Screen Save was successful, 1 *
* otherwise (lack of memory). *
* SYNTAX: *
* SaveScreen(VirtualScreen, 25, Result); *
* NOTE(S): *
* See also RestoreScreen procedure. *
* ----------------------------------------------------------------------} *
* *
* Procedure RestoreScreen(aScreen: ScreenType); *
* { *
* DESCRIPTION: *
* Restores a text screen stored in variable aScreen to Video *
* Display Memory instantly. *
* PARAMETERS: *
* aScreen (in) - "Screen" [variable] to restore. Will be place *
* directly to Video Display Memory for an *
* instantaneous text display. *
* SYNTAX: *
* RestoreScreen(VirtualScreen); *
* NOTE(S): *
* See also SaveScreen procedure. It is not necessary to pass in *
* the height of the screen again since it is saved when you make *
* a call to SaveScreen. *
* ----------------------------------------------------------------------} *
* *
* Function NumSecsMidNight: Real; *
* { *
* DESCRIPTION: *
* Returns the number of seconds elapsed since Midnight. *
* SYNTAX: *
* 1. Writeln(NumSecsMidNight:0:2); *
* 2. r := NumSecsMidNight; *
* NOTE(S): *
* Used primarily by CheckTime procedure. *
* ----------------------------------------------------------------------} *
* Procedure DelaySeconds(NumSecs: Real; KeyIntr: Boolean); *
* { *
* DESCRIPTION: *
* Delays a specified number of seconds. *
* PARAMETERS: *
* NumSecs (in) - Number of seconds to wait. *
* KeyIntr (in) - Pass in ON or OFF to specify whether or not *
* to allow a keypress to bypass the full wait. *
* SYNTAX: *
* DelaySeconds(5.0, ON); *
* - Pauses system for about five seconds. If a key is pressed *
* before time has expired. *
* NOTE(S): *
* Useful for programs which may half to run on various levels *
* of PCs, since Turbo's Delay command produces unpredictable *
* affects. AdvCRT's procedure uses the system clock to delay. *
* DelaySeconds is a close approximation, but the time will not *
* be exactly NumSecs seconds. *
* ----------------------------------------------------------------------} *
* *
* Procedure CheckTime(Action: Byte); *
* { *
* DESCRIPTION: *
* Checks the length of time a specific task takes. Can be used *
* as a programming aid to time procedures, etc. *
* PARAMETERS: *
* Action (in) - 0, 1, or 2 are valid parameters. *
* 0 to reset timer *
* 1 to start timer *
* 2 to stop timer *
* ElapsedTime N/A - Global variable which stores the elapsed *
* time since the timer was turned on. *
* SYNTAX: *
* CheckTime(0); *
* - Resets AdvCRT's internal timer. *
* CheckTime(1); *
* - Turns timer ON. *
* CheckTime(2); Writeln(ElapsedTime); *
* - Turns timer OFF. Displays the amount of time elapsed since *
* the timer was turned on. *
* NOTE(S): *
* AdvCRT's internal "timer" is a real global variable "StoreTime" *
* and may be manipulated if need be. *
* ----------------------------------------------------------------------} *
* *
* Procedure CapsLockKey(ONorOFF: Boolean); *
* { *
* DESCRIPTION: *
* Sets the keyboard CAPS-LOCK state to Upper Case or Lower Case. *
* PARAMETERS: *
* ONorOFF (in) - Pass in ON to set keyboard to Upper Case state, *
* or OFF to set keyboard to Lower Case state *
* SYNTAX: *
* 1. CapsLockKey(ON); - Turns CAPS-LOCK state ON *
* 2. CapsLockKey(OFF); - Turns CAPS-LOCK state OFF *
* NOTE(S): *
* Sets the CAPS-LOCK state regardless of what the current state *
* happens to be. *
* ----------------------------------------------------------------------} *
* *
* Procedure NumLockKey(ONorOFF: Boolean); *
* { *
* DESCRIPTION: *
* Sets the keypad to its Cursor Control or Numeric state. *
* PARAMETERS: *
* ONorOFF (in) - Pass in ON to set the keypad to its Numeric *
* state, or OFF keypad to its Cursor Control state *
* SYNTAX: *
* 1. NumLockKey(ON); - Turns NUM-LOCK state ON *
* 2. NumLockKey(OFF); - Turns NUM-LOCK state OFF *
* NOTE(S): *
* Sets the NUM-LOCK state regardless of what the current state *
* happens to be. *
* ----------------------------------------------------------------------} *
* *
* Procedure PrintScreen(var Status: Byte); *
* { *
* DESCRIPTION: *
* Causes the current text or graphics screen to be printed to *
* printer 0, the default printer. *
* PARAMETERS: *
* Status (out) - Status of the Print-Screen procedure *
* 00 - OK status *
* 01 - A Print-Screen operation is currently in progress *
* 255 - An error occured during a Print-Screen *
* SYNTAX: *
* PrintScreen(Status); *
* NOTE(S): *
* Identical to standard "Shift-PrtSc" key on the keyboard. *
* Note that in order to print graphics screens, it may be *
* necessary to first install the GRAPHICS.COM program found on *
* your DOS distribution diskette. *
* ----------------------------------------------------------------------} *
* *
* Procedure PurgeKBDBuffer; *
* { *
* DESCRIPTION: *
* Causes a purge of the type-ahead keyboard buffer. Any characters *
* which may have existed between the HEAD and TAIL of the keyboard *
* buffer [circular] queue are cleared. *
* SYNTAX: *
* ClrScr; *
* PurgeKBDBuffer; *
* Write('Press any key to continue...'); *
* GetKey(Code, ExtendedKey); *
* NOTE(S): *
* This procedure uses the global addresses KBDBufferHead and *
* KBDBufferTail which point to the PC's internal type-ahead *
* keyboard buffer. *
* ----------------------------------------------------------------------} *
* *
* Function SizeKBDBuffer: Integer; *
* { *
* DESCRIPTION: *
* Returns the size (in bytes) of the type-ahead keyboard buffer. *
* Default size for PCs is 16 bytes. * *
* SYNTAX: *
* Writeln('Keyboard buffer size: ', SizeKBDBuffer); *
* NOTE(S): *
* This function is type Integer (instead of Byte) because of the *
* fact that the size of the buffer may indeed be greater than *
* a Byte's maximum value of 255. *
* ----------------------------------------------------------------------} *
* *
*****************************************************************************)
